home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 2.iso / dist / fw_guile.idb / usr / freeware / share / guile / 1.5.6 / scripts / generate-autoload.z / generate-autoload
Text File  |  2002-07-08  |  6KB  |  147 lines
  1. #!/bin/sh
  2. # aside from this initial boilerplate, this is actually -*- scheme -*- code
  3. main='(module-ref (resolve-module '\''(scripts generate-autoload)) '\'main')'
  4. exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
  5. !#
  6. ;;; generate-autoload --- Display define-module form with autoload info
  7.  
  8. ;;     Copyright (C) 2001 Free Software Foundation, Inc.
  9. ;;
  10. ;; This program is free software; you can redistribute it and/or
  11. ;; modify it under the terms of the GNU General Public License as
  12. ;; published by the Free Software Foundation; either version 2, or
  13. ;; (at your option) any later version.
  14. ;;
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19. ;;
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with this software; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  23. ;; Boston, MA 02111-1307 USA
  24.  
  25. ;;; Author: Thien-Thi Nguyen
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; Usage: generate-autoload [OPTIONS] FILE1 FILE2 ...
  30. ;;
  31. ;; The autoload form is displayed to standard output:
  32. ;;
  33. ;; (define-module (guile-user)
  34. ;;   :autoload (ZAR FOO) (FOO-1 FOO-2 ...)
  35. ;;     :
  36. ;;     :
  37. ;;   :autoload (ZAR BAR) (BAR-1 BAR-2 ...))
  38. ;;
  39. ;; For each file, a symbol triggers an autoload if it is found in one
  40. ;; of these situations:
  41. ;;  - in the `:export' clause of a `define-module' form
  42. ;;  - in a top-level `export' or `export-syntax' form
  43. ;;  - in a `define-public' form
  44. ;;  - in a `defmacro-public' form
  45. ;;
  46. ;; The module name is inferred from the `define-module' form.  If either the
  47. ;; module name or the exports list cannot be determined, no autoload entry is
  48. ;; generated for that file.
  49. ;;
  50. ;; Options:
  51. ;; --target MODULE-NAME         -- Use MODULE-NAME instead of `(guile-user)'.
  52. ;;                                 Note that some shells may require you to
  53. ;;                                 quote the argument to handle parentheses
  54. ;;                                 and spaces.
  55. ;;
  56. ;; Usage examples from Scheme code as a module:
  57. ;; (use-modules (scripts generate-autoload))
  58. ;; (generate-autoload "generate-autoload")
  59. ;; (generate-autoload "--target" "(my module)" "generate-autoload")
  60. ;; (apply generate-autoload "--target" "(my module)" '("foo" "bar" "baz"))
  61.  
  62. ;;; Code:
  63.  
  64. (define-module (scripts generate-autoload)
  65.   :export (generate-autoload))
  66.  
  67. (define (autoload-info file)
  68.   (let ((p (open-input-file file)))
  69.     (let loop ((form (read p)) (module-name #f) (exports '()))
  70.       (if (eof-object? form)
  71.           (and module-name
  72.                (not (null? exports))
  73.                (list module-name exports)) ; ret
  74.           (cond ((and (list? form)
  75.                       (< 1 (length form))
  76.                       (eq? 'define-module (car form)))
  77.                  (loop (read p)
  78.                        (cadr form)
  79.                        (cond ((member ':export form)
  80.                               => (lambda (val)
  81.                                    (append (cadr val) exports)))
  82.                              (else exports))))
  83.                 ((and (list? form)
  84.                       (< 1 (length form))
  85.                       (memq (car form) '(export export-syntax)))
  86.                  (loop (read p)
  87.                        module-name
  88.                        (append (cdr form) exports)))
  89.                 ((and (list? form)
  90.                       (< 2 (length form))
  91.                       (eq? 'define-public (car form))
  92.                       (list? (cadr form))
  93.                       (symbol? (caadr form)))
  94.                  (loop (read p)
  95.                        module-name
  96.                        (cons (caadr form) exports)))
  97.                 ((and (list? form)
  98.                       (< 2 (length form))
  99.                       (eq? 'define-public (car form))
  100.                       (symbol? (cadr form)))
  101.                  (loop (read p)
  102.                        module-name
  103.                        (cons (cadr form) exports)))
  104.                 ((and (list? form)
  105.                       (< 3 (length form))
  106.                       (eq? 'defmacro-public (car form))
  107.                       (symbol? (cadr form)))
  108.                  (loop (read p)
  109.                        module-name
  110.                        (cons (cadr form) exports)))
  111.                 (else (loop (read p) module-name exports)))))))
  112.  
  113. (define (generate-autoload . args)
  114.   (let* ((module-count 0)
  115.          (syms-count 0)
  116.          (target-override (cond ((member "--target" args) => cadr)
  117.                                 (else #f)))
  118.          (files (if target-override (cddr args) (cdr args))))
  119.     (display ";;; do not edit --- generated ")
  120.     (display (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
  121.     (newline)
  122.     (display "(define-module ")
  123.     (display (or target-override "(guile-user)"))
  124.     (for-each (lambda (file)
  125.                 (cond ((autoload-info file)
  126.                        => (lambda (info)
  127.                             (and info
  128.                                  (apply (lambda (module-name exports)
  129.                                           (set! module-count (1+ module-count))
  130.                                           (set! syms-count (+ (length exports)
  131.                                                               syms-count))
  132.                                           (for-each display
  133.                                                     (list "\n  :autoload "
  134.                                                           module-name " "
  135.                                                           exports)))
  136.                                         info))))))
  137.               files)
  138.     (display ")")
  139.     (newline)
  140.     (for-each display (list "  ;;; "
  141.                             syms-count " symbols in "
  142.                             module-count " modules\n"))))
  143.  
  144. (define main generate-autoload)
  145.  
  146. ;;; generate-autoload ends here
  147.